Holt Researcher: American History/Holt Researcher: American History.iso/pc/modules/dbtable.dxr/00015_Text & List Code.ls

Text File | 2000-01-18 | 6.6 KB | 293 lines

global gDBTableVarList

on EvalKeyPressed
  if IsKeyBoardEquivalentDown() then
    MyObj = getaProp(gDBTableVarList, GetObjProp())
    case the key of
      "c":
        TableCopy(MyObj)
      "p":
        print(MyObj)
      "s":
        save(MyObj)
    end case
  end if
end

on DeleteFirstItem xList
  DupList = duplicate(xList)
  deleteAt(DupList, 1)
  return DupList
end

on SearchList xList, target
  ListCount = count(xList)
  repeat with rc1 = 1 to ListCount
    xItem = getAt(xList, rc1)
    if listp(xItem) then
      repeat with rc2 in xItem
        if xItem = target then
          FoundIndex = rc1
        end if
      end repeat
      next repeat
    end if
    if xItem = target then
      FoundIndex = rc1
    end if
  end repeat
  return FoundIndex
end

on MakePlatformFileName xText
  xText = RemoveReturns(xText)
  xText = RemovePathDelimiters(xText)
  if the machineType = 256 then
    if xText contains "." then
      Pos = offset(".", xText)
      xText = char 1 to Pos - 1 of xText
    end if
    legalChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890"
    MaxCount = length(xText)
    repeat with rc = 1 to MaxCount
      if not (legalChars contains char rc of xText) then
        put " " into char rc of xText
      end if
    end repeat
    repeat while xText contains " "
      CharNum = offset(" ", xText)
      if CharNum > 0 then
        delete char CharNum of xText
      end if
    end repeat
    return char 1 to 8 of xText
  else
    return xText
  end if
end

on MakeNumericOnly xText
  legalChars = "1234567890"
  MaxCount = length(xText)
  repeat with rc = 1 to MaxCount
    if not (legalChars contains char rc of xText) then
      put " " into char rc of xText
    end if
  end repeat
  repeat while xText contains " "
    CharNum = offset(" ", xText)
    if CharNum > 0 then
      delete char CharNum of xText
    end if
  end repeat
  return xText
end

on GetOnStageRects TableRectList
  OnStageList = []
  StageRect = rect(0, 0, the stageRight - the stageLeft, the stageBottom - the stageTop)
  repeat with xRect in TableRectList
    if inside(point(xRect.left, xRect.top), StageRect) and inside(point(xRect.right, xRect.bottom), StageRect) then
      append(OnStageList, xRect)
    end if
  end repeat
  return OnStageList
end

on GetRectWidth xRect
  return getAt(xRect, 1) - getAt(xRect, 3)
end

on GetRectHeight xRect
  return getAt(xRect, 4) - getAt(xRect, 2)
end

on RemoveBlankLines xText
  ReturnString = xText
  LineMax = the number of lines in ReturnString
  repeat with rc = LineMax down to 1
    LineText = line rc of ReturnString
    if (LineText = EMPTY) or (LineText = " ") then
      delete line rc of ReturnString
      LineMax = the number of lines in ReturnString
    end if
  end repeat
  return ReturnString
end

on ReplaceCaretwithReturn xText
  repeat while xText contains "^"
    Pos = offset("^", xText)
    put RETURN into char Pos of xText
  end repeat
  return xText
end

on FindandReplace xText, FindText, ReplaceText
  if ReplaceText = EMPTY then
    alert("FindandReplace: ReplaceText cannot be Empty String")
  end if
  MaxCount = length(xText)
  repeat with rc = 1 to MaxCount
    if charToNum(FindText) = charToNum(char rc of xText) then
      put ReplaceText into char rc of xText
    end if
  end repeat
  return xText
end

on RemoveString xText, FindText
  MaxCount = length(xText)
  repeat while xText contains FindText
    Pos = offset(FindText, xText)
    delete char Pos of xText
  end repeat
  return xText
end

on CountNBSpace xText
  count = 0
  WindowsNBS = numToChar(160)
  MacNBS = numToChar(202)
  repeat while xText contains WindowsNBS
    Pos = offset(WindowsNBS, xText)
    count = count + 1
    delete char Pos of xText
  end repeat
  repeat while xText contains MacNBS
    Pos = offset(MacNBS, xText)
    count = count + 1
    delete char Pos of xText
  end repeat
  return count
end

on AppendNbs xText, MaxCount
  if the machineType = 256 then
    nbs = numToChar(160)
  else
    nbs = numToChar(202)
  end if
  repeat with rc = 1 to MaxCount
    xText = xText & nbs
  end repeat
  return xText
end

on RectToLoc xRect
  l = getAt(xRect, 1)
  t = getAt(xRect, 2)
  R = getAt(xRect, 3)
  b = getAt(xRect, 4)
  xCenter = (R - l) / 2
  if ((l mod 2) = 1) and ((R mod 2) = 1) then
    xCenter = xCenter - 1
  end if
  yCenter = (b - t) / 2
  xPoint = point(l + xCenter, t + yCenter)
  return xPoint
end

on IsRectVisible xRect
  l = getAt(xRect, 1)
  t = getAt(xRect, 2)
  R = getAt(xRect, 3)
  b = getAt(xRect, 4)
  return inside(point(l, t), (the stage).rect) and inside(point(R, b), (the stage).rect)
end

on CreateLookUpList paramList
  list = []
  repeat with rc in paramList
    append(list, getPos(paramList, rc))
  end repeat
  return list
end

on LineItemCount xText
  storeDelimiter = the itemDelimiter
  the itemDelimiter = TAB
  xNumber = the number of items in xText
  the itemDelimiter = storeDelimiter
  return xNumber
end

on BlankLine xText
  return (xText = EMPTY) or (xText = " ")
end

on RemoveSpaces xText
  ReturnString = xText
  repeat while ReturnString contains " "
    SpaceLoc = offset(" ", ReturnString)
    delete char SpaceLoc of ReturnString
  end repeat
  return ReturnString
end

on RemovePathDelimiters xText
  if the machineType = 256 then
    delimiter = "\"
  else
    delimiter = ":"
  end if
  repeat while xText contains delimiter
    CharNum = offset(delimiter, xText)
    if CharNum > 0 then
      delete char CharNum of xText
    end if
  end repeat
  return xText
end

on RemoveBorderSpaces xText
  ReturnString = xText
  repeat while char 1 of ReturnString = " "
    delete char 1 of ReturnString
  end repeat
  repeat while char length(ReturnString) of ReturnString = " "
    delete char length(ReturnString) of ReturnString
  end repeat
  return ReturnString
end

on InSelection SpriteRect, selRect
  SpriteL = getAt(SpriteRect, 1) + 2
  SpriteT = getAt(SpriteRect, 2) + 2
  SpriteR = getAt(SpriteRect, 3) - 2
  SpriteB = getAt(SpriteRect, 4) - 2
  if inside(point(SpriteL, SpriteT), selRect) then
    return 1
  end if
  if inside(point(SpriteL, SpriteB), selRect) then
    return 1
  end if
  if inside(point(SpriteR, SpriteT), selRect) then
    return 1
  end if
  if inside(point(SpriteR, SpriteB), selRect) then
    return 1
  end if
  return 0
end

on EvalRectUnion SpriteRect, selRect
  SpriteL = getAt(SpriteRect, 1) + 2
  SpriteT = getAt(SpriteRect, 2) + 2
  SpriteR = getAt(SpriteRect, 3) - 2
  SpriteB = getAt(SpriteRect, 4) - 2
  if inside(point(SpriteL, SpriteT), selRect) then
    return 1
  end if
  if inside(point(SpriteL, SpriteB), selRect) then
    return 1
  end if
  if inside(point(SpriteR, SpriteT), selRect) then
    return 1
  end if
  if inside(point(SpriteR, SpriteB), selRect) then
    return 1
  end if
  return 0
end